' Search a file for a given string.
' Difference to AmigaDOS command SEARCH:
' string may contain control chars,
' a binary file can be searched. 
' P. Kittel, CBM Ffm, Start 6.1.87, 24.2.87

vl=10:nl=10 ' default pre-run, past-run

Start:
CLS
PRINT "Search  - Search a File for a Given String
PRINT 
PRINT "Include in quotes when giving a whole path description:
PRINT"File name ";f$;:INPUT" = ";ff$
IF ff$<>"" THEN f$=ff$
IF f$ = "" THEN RUN

PRINT :PRINT "Type string to be searched for:
PRINT "include normal text in quotes,
PRINT "enter other single chars as decimal codes or
PRINT "as a hex code preceded by a dollar sign,
PRINT "mark end of string by a simple e :

s$="":se$=""
WHILE se$<>"e"    '" one char or string fraction per time
  LINE INPUT se$
  WHILE LEFT$(se$,1)=" ":se$=MID$(se$,2):WEND            ' cancel leading and
  WHILE RIGHT$(se$,1)=" ":se$=LEFT$(se$,LEN(se$)-1):WEND ' following spaces
  
  IF LEFT$(se$,1)=CHR$(34) THEN ' quotes mark normal string
    se$=MID$(se$,2)
    IF RIGHT$(se$,1)=CHR$(34) THEN se$=LEFT$(se$,LEN(se$)-1)
    s$=s$+se$:se$=""
    
    ELSEIF LEFT$(se$,1)="$" THEN ' Dollar marks input in hex
    s=0
    IF LEN(se$)>1 THEN
      FOR i=2 TO LEN(se$)                ' hex to dec conversion
        si=ASC(UCASE$(MID$(se$,i,1)))-48
        IF si>9 THEN si=si-7
        IF si<0 OR si>15 THEN PRINT :PRINT "Unexpected char ";MID$(se$,i,1);" !":PRINT :END
        s=16*s+si
        NEXT
      END IF
    IF s<0 OR s>255 THEN PRINT :PRINT "Impossible code value!":END
    s$=s$+CHR$(s)
    
    ELSEIF se$<>"e" THEN ' remains only:
    s=VAL(se$)           '               code in dec 
    IF s<0 OR s>255 THEN PRINT :PRINT "Impossible code value!":END
    s$=s$+CHR$(s)
    
    END IF
  WEND

' search string length delimited to 100 bytes (randomly chosen value)
IF LEN(s$)>100 THEN PRINT :PRINT "Search string too long!":END
l=LEN(s$):IF l<100 THEN l=100
n=0:a$="":ls=LEN(s$)

PRINT :PRINT "Pre-run and past-run mean count of bytes to show maximally 
PRINT "before and after an actual occurence of search string in the file: 
PRINT :PRINT "Pre-run  maximal in bytes ";vl;:INPUT" = ";a$
IF a$<>"" THEN vl=VAL(a$)
PRINT :PRINT "Past-run maximal in bytes ";nl;:INPUT" = ";a$
IF a$<>"" THEN nl=VAL(a$)
PRINT

PRINT "Abort search with q key, pause with any.":PRINT 

OPEN f$ FOR INPUT AS 1:lo=LOF(1):PRINT "File length:";lo;"bytes":PRINT 
WHILE (NOT EOF(1)) AND l>0   ' loop for whole file
  aa$=a$:ii=LEN(a$)
  IF n+ii+l>lo THEN l=lo-n-ii
  a$=INPUT$(l,1)             ' read
  
  Abfrage:
  g$=INKEY$                  ' key pressed?
  IF g$<>"" THEN
    IF g$<>"q" THEN g$="":WHILE g$="":g$=INKEY$:WEND ' wait for another key
    IF g$="q" THEN l=0:a$="" ' abort with q key
    END IF
  is=INSTR(aa$+a$,s$) ' always consider new (a$) and last (aa$) fraction together
  IF is>0 THEN  
    ii=0:nn=n   ' search string found
    ab$=aa$+a$   
    ' omit bytes until pre-run:
    IF is>vl THEN ab$=MID$(ab$,is-vl):nn=nn+is-vl-1:n=n+is-vl-1:is=is-is+vl+1
    ad$=ab$
    ' omit bytes after past-run:
    IF is+ls+nl<LEN(ab$) THEN ab$=LEFT$(ab$,is+ls+nl)
    lb=LEN(ab$):ac$=""
    PRINT 
    FOR i=1 TO LEN(ab$) ' loop for region to be shown
      IF ac$="" THEN PRINT RIGHT$("000"+HEX$(nn),4);"  "; ' address in file in hex
      ii=ii+1
      a=ASC(MID$(ab$,i,1))
      IF i>=is AND i<is+ls THEN COLOR 3 ' mark search string by color
      PRINT RIGHT$("0"+HEX$(a),2);" ";  ' single hexbyte
      COLOR 1
      ac$=ac$+CHR$(a)
      IF ii=16 OR i=lb THEN  ' show as normal chars on the right
        PRINT "  ";:IF i=lb THEN PRINT SPC(3*(16-ii));
        IF ac$<>"" THEN
          FOR ij=1 TO LEN(ac$)
            a=ASC(MID$(ac$,ij,1))
            ' mark control chars by color:
            IF a<32 THEN COLOR 2:PRINT CHR$(a+64);:COLOR 1 :ELSE PRINT CHR$(a);
            NEXT
          END IF
        ac$="":nn=nn+ii:ii=0
        PRINT 
        END IF
      g$=INKEY$       ' key pressed?
      IF g$<>"" THEN
        IF g$<>"q" THEN g$="":WHILE g$="":g$=INKEY$:WEND ' wait for another key
        IF g$="q" THEN i=1e+09 ' abort with q key
        END IF
      NEXT
    ' search string in this fraction another time?
    IF is+ls<LEN(ad$)-ls THEN aa$="":a$=MID$(ad$,is+1):n=n+is:GOTO Abfrage
    a$=ad$  ' actualize a$ (actual fraction of file)
            ELSE
    ii=LEN(aa$+a$):IF ii>l THEN a$=RIGHT$(aa$+a$,l):n=n+ii-l
    END IF
  WEND
  
CLOSE 1

PRINT :PRINT "Continue with any key, abort with q ."
a$="":WHILE a$="":a$=INKEY$:WEND

IF a$<>"q" THEN Start
END